Assignment #2

# SEE modeldata package for new datasets
library(tidyverse)         # for graphing and data cleaning

## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.0 ──

## ✓ ggplot2 3.3.2     ✓ purrr   0.3.4
## ✓ tibble  3.1.0     ✓ dplyr   1.0.5
## ✓ tidyr   1.1.2     ✓ stringr 1.4.0
## ✓ readr   1.3.1     ✓ forcats 0.5.0

## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()

library(tidymodels)        # for modeling

## ── Attaching packages ────────────────────────────────────── tidymodels 0.1.2 ──

## ✓ broom     0.7.3      ✓ recipes   0.1.15
## ✓ dials     0.0.9      ✓ rsample   0.0.9 
## ✓ infer     0.5.4      ✓ tune      0.1.3 
## ✓ modeldata 0.1.0      ✓ workflows 0.2.2 
## ✓ parsnip   0.1.5      ✓ yardstick 0.0.7

## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## x scales::discard() masks purrr::discard()
## x dplyr::filter()   masks stats::filter()
## x recipes::fixed()  masks stringr::fixed()
## x dplyr::lag()      masks stats::lag()
## x yardstick::spec() masks readr::spec()
## x recipes::step()   masks stats::step()

library(stacks)            # for stacking models
library(naniar)            # for examining missing values (NAs)
library(lubridate)         # for date manipulation

## 
## Attaching package: 'lubridate'

## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union

library(moderndive)        # for King County housing data
library(vip)               # for variable importance plots

## 
## Attaching package: 'vip'

## The following object is masked from 'package:utils':
## 
##     vi

library(DALEX)             # for model interpretation  

## Welcome to DALEX (version: 2.2.0).
## Find examples and detailed introduction at: http://ema.drwhy.ai/

## 
## Attaching package: 'DALEX'

## The following object is masked from 'package:dplyr':
## 
##     explain

library(DALEXtra)          # for extension of DALEX

## Anaconda not found on your computer. Conda related functionality such as create_env.R and condaenv and yml parameters from explain_scikitlearn will not be available

library(patchwork)         # for combining plots nicely
library(kknn)              # for knn models
theme_set(theme_minimal()) # Lisa's favorite theme

data("lending_club")
# Data dictionary (as close as I could find): https://www.kaggle.com/wordsforthewise/lending-club/discussion/170691

When you finish the assignment, remove the # from the options chunk at the top, so that messages and warnings aren’t printed. If you are getting errors in your code, add error = TRUE so that the file knits. I would recommend not removing the # until you are completely finished.

Put it on GitHub!

From now on, GitHub should be part of your routine when doing assignments. I recommend making it part of your process anytime you are working in R, but I’ll make you show it’s part of your process for assignments.

Task: When you are finished with the assignment, post a link below to the GitHub repo for the assignment. If you want to post it to your personal website, that’s ok (not required). Make sure the link goes to a spot in the repo where I can easily find this assignment. For example, if you have a website with a blog and post the assignment as a blog post, link to the post’s folder in the repo. As an example, I’ve linked to my GitHub stacking material here.

Link to Assignment 2

Modeling

Before jumping into these problems, you should read through (and follow along with!) the model stacking and global model interpretation tutorials on the Course Materials tab of the course website.

We’ll be using the lending_club dataset from the modeldata library, which is part of tidymodels. The data dictionary they reference doesn’t seem to exist anymore, but it seems the one on this kaggle discussion is pretty close. It might also help to read a bit about Lending Club before starting in on the exercises.

The outcome we are interested in predicting is Class. And according to the dataset’s help page, its values are “either ‘good’ (meaning that the loan was fully paid back or currently on-time) or ‘bad’ (charged off, defaulted, of 21-120 days late)”.

Tasks: I will be expanding these, but this gives a good outline.

1. Explore the data, concentrating on examining distributions of variables and examining missing values.

Distributions of quantitative variables

lending_club %>% 
  select(where(is.numeric)) %>% 
  pivot_longer(cols = everything(),
               names_to = "variable", 
               values_to = "value") %>% 
  ggplot(aes(x = value)) +
  geom_histogram() +
  facet_wrap(vars(variable), 
             scales = "free")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

#cleaning: remove delinq amount dataset b/c it was highly correlated probably

Categorical variables

lending_club %>% 
  select(where(is.factor)) %>% 
  pivot_longer(cols = everything(),
               names_to = "variable", 
               values_to = "value") %>% 
  ggplot(aes(x = value)) +
  geom_bar() +
  facet_wrap(vars(variable), 
             scales = "free", 
             nrow = 2)

Looking at missing values

gg_miss_var(lending_club)

#No missing values!

2. Do any data cleaning steps that need to happen before the model is build. For example, you might remove any variables that mean the same thing as the response variable (not sure if that happens here), get rid of rows where all variables have missing values, etc.

#remove variables that have overwhelming amounts of zeros and are likely highly correlated with the outcome
lending_club <- lending_club %>%
  select(-delinq_amnt,-acc_now_delinq)

#lump states based on region
regions <- read.csv("statesregions.csv")

regions <- regions %>%
  mutate(addr_state = State.Code)

#changing the addr_state variable to Region so it has less levels
lending_club <- lending_club %>%
  left_join(regions) %>%
  select(-addr_state, -State, -State.Code, -Division) %>%
  mutate(Region = as.factor(Region))

## Joining, by = "addr_state"

lending_club

Be sure to add more “bad” Classes. This is not the best solution, but it will work for now. (Should investigate how to appropriately use step_sample_up() function from themis).

set.seed(494)

create_more_bad <- lending_club %>% 
  filter(Class == "bad") %>% 
  sample_n(size = 3000, replace = TRUE)

lending_club_mod <- lending_club %>% 
  bind_rows(create_more_bad)

3. Split the data into training and test, putting 75% in the training data.

set.seed(494) # for reproducibility

#randomly assign 75% of the data to training
lending_club_split <- initial_split(lending_club_mod, strata = 'Class', prop = .75)

lending_club_split

## <Analysis/Assess/Total>
## <9643/3214/12857>

#training and testing datasets
lending_club_training <- training(lending_club_split)
lending_club_testing <- testing(lending_club_split)

4. Set up the recipe and the pre-processing steps to build a lasso model. Some steps you should take:

• Make all integer variables numeric (I’d highly recommend using step_mutate_at() or this will be a lot of code). We’ll want to do this for the model interpretation we’ll do later.
  
• Think about grouping factor variables with many levels. I did it for the states above because it felt more intuitive for me to modify the dataset before I made the mod so I could get rid of addr_state.

#seeing which factor variables have many levels
lapply(lending_club, levels)

## $funded_amnt
## NULL
## 
## $term
## [1] "term_36" "term_60"
## 
## $int_rate
## NULL
## 
## $sub_grade
##  [1] "A1" "A2" "A3" "A4" "A5" "B1" "B2" "B3" "B4" "B5" "C1" "C2" "C3" "C4" "C5"
## [16] "D1" "D2" "D3" "D4" "D5" "E1" "E2" "E3" "E4" "E5" "F1" "F2" "F3" "F4" "F5"
## [31] "G1" "G2" "G3" "G4" "G5"
## 
## $verification_status
## [1] "Not_Verified"    "Source_Verified" "Verified"       
## 
## $annual_inc
## NULL
## 
## $emp_length
##  [1] "emp_lt_1"  "emp_1"     "emp_ge_10" "emp_2"     "emp_3"     "emp_4"    
##  [7] "emp_5"     "emp_6"     "emp_7"     "emp_8"     "emp_9"     "emp_unk"  
## 
## $delinq_2yrs
## NULL
## 
## $inq_last_6mths
## NULL
## 
## $revol_util
## NULL
## 
## $open_il_6m
## NULL
## 
## $open_il_12m
## NULL
## 
## $open_il_24m
## NULL
## 
## $total_bal_il
## NULL
## 
## $all_util
## NULL
## 
## $inq_fi
## NULL
## 
## $inq_last_12m
## NULL
## 
## $num_il_tl
## NULL
## 
## $total_il_high_credit_limit
## NULL
## 
## $Class
## [1] "bad"  "good"
## 
## $Region
## [1] "Midwest"   "Northeast" "South"     "West"

#lump all the As together, and Bs, etc.

• Make categorical variables dummy variables (make sure NOT to do this to the outcome variable).
  
• Normalize quantitative variables.

lending_recipe <- recipe(Class ~ ., data = lending_club_training) %>%
  step_mutate_at(all_numeric(), fn = ~ as.numeric(.)) %>% #make all numeric vars numeric
  step_mutate(sub_grade = fct_collapse(sub_grade, A = c("A1","A2","A3","A4","A5"), 
               B = c("B1","B2","B3","B4","B5"), 
               C = c("C1","C2","C3","C4","C5"), #collapsing levels in sub_grade into less
               D = c("D1","D2","D3","D4","D5"), 
               E = c("E1","E2","E3","E4","E5"),
               f = c("F1","F2","F3","F4","F5"),
               G = c("G1","G2","G3","G4","G5"))) %>%
  step_normalize(all_predictors(),-all_nominal()) %>% #normalize quantitative vars
  step_dummy(all_nominal(),-all_outcomes()) #make categorical vars dummy vars


#using prep and juice to make sure everything went as planned
lending_recipe %>%
  prep(lending_club_training) %>%
  juice()

5. Set up the lasso model and workflow. We will tune the penalty parameter.

#lasso model
lending_lasso_mod <-
  logistic_reg(mixture = 1) %>%
  set_engine("glmnet") %>%
  set_args(penalty = tune()) %>%
  set_mode("classification")

#lasso workflow
lending_lasso_wf <-
  workflow() %>%
  add_recipe(lending_recipe) %>%
  add_model(lending_lasso_mod)

lending_lasso_wf

## ══ Workflow ════════════════════════════════════════════════════════════════════
## Preprocessor: Recipe
## Model: logistic_reg()
## 
## ── Preprocessor ────────────────────────────────────────────────────────────────
## 4 Recipe Steps
## 
## ● step_mutate_at()
## ● step_mutate()
## ● step_normalize()
## ● step_dummy()
## 
## ── Model ───────────────────────────────────────────────────────────────────────
## Logistic Regression Model Specification (classification)
## 
## Main Arguments:
##   penalty = tune()
##   mixture = 1
## 
## Computational engine: glmnet

6. Set up the model tuning for the penalty parameter. Be sure to add the control_stack_grid() for the control argument so we can use these results later when we stack. Find the accuracy and area under the roc curve for the model with the best tuning parameter. Use 5-fold cv.

set.seed(494) #for reproducible 5-fold

#5-fold cross-validation
lending_cv <- vfold_cv(lending_club_training, v = 5)

#penalty grid: 10 levels
penalty_grid <- grid_regular(penalty(),
                             levels = 10)

#make sure predictions and workflows are saved for stacking in the future
ctrl_grid <- control_stack_grid()

#tune using 5-fold cv
lending_lasso_tune <-
  lending_lasso_wf %>%
  tune_grid(
    resamples = lending_cv,
    grid = penalty_grid,
    control = ctrl_grid
  )

lending_accuracy <- lending_lasso_tune %>%
  collect_metrics() %>%
  filter(.metric == "accuracy")

lending_roc_auc <- lending_lasso_tune %>%
  collect_metrics() %>%
  filter(.metric == "roc_auc")

ggplot(lending_accuracy, aes(x = penalty, y = mean)) +
  geom_point() +
  geom_line() +
  scale_x_log10(
   breaks = scales::trans_breaks("log10", function(x) 10^x),
   labels = scales::trans_format("log10",scales::math_format(10^.x))) +
  ggtitle("Accuracy over different penalties") +
  ylab("accuracy")

ggplot(lending_roc_auc, aes(x = penalty, y = mean)) +
  geom_point() +
  geom_line() +
  scale_x_log10(
   breaks = scales::trans_breaks("log10", function(x) 10^x),
   labels = scales::trans_format("log10",scales::math_format(10^.x))) +
  ggtitle("Area under roc curve over different penalties") +
  ylab("roc_auc")

#select best tuning parameter (accuracy and area under roc curve)
best_param_lending <- lending_lasso_tune %>%
  select_best(metric = "accuracy", "roc_auc")

#Is it always the case that the best tuning parameter will be the same for these two metrics?
best_param_lending

#best tuning parameter is 0.0004641589

#accuracy for best tuning parameter: 0.7487296
#area under roc curve for best tuning parameter: 0.7656651

# finalize workflow
lending_lasso_final_wf <- lending_lasso_wf %>%
  finalize_workflow(best_param_lending)

#fit final model with best tuning parameter
lending_lasso_final_mod <- lending_lasso_final_wf %>%
  fit(data = lending_club)

7. Set up the recipe and the pre-processing steps to build a random forest model. You shouldn’t have to do as many steps. The only step you should need to do is making all integers numeric.

#preprocessing
lending_recipe_forest <- recipe(Class ~ ., data = lending_club_training) %>%
  step_mutate_at(all_numeric(), fn = ~ as.numeric(.))

8. Set up the random forest model and workflow. We will tune the mtry and min_n parameters and set the number of trees, trees, to 100 (otherwise the next steps take too long).

#build model
lending_forest_mod <-
  rand_forest(mtry = tune(), min_n = tune(), trees = 200) %>%
  set_mode("classification") %>%
  set_engine("ranger")

#workflow
lending_forest_wf <-
  workflow() %>%
  add_recipe(lending_recipe_forest) %>%
  add_model(lending_forest_mod)

lending_forest_wf

## ══ Workflow ════════════════════════════════════════════════════════════════════
## Preprocessor: Recipe
## Model: rand_forest()
## 
## ── Preprocessor ────────────────────────────────────────────────────────────────
## 1 Recipe Step
## 
## ● step_mutate_at()
## 
## ── Model ───────────────────────────────────────────────────────────────────────
## Random Forest Model Specification (classification)
## 
## Main Arguments:
##   mtry = tune()
##   trees = 200
##   min_n = tune()
## 
## Computational engine: ranger

9. Set up the model tuning for both the mtry and min_n parameters. Be sure to add the control_stack_grid() for the control argument so we can use these results later when we stack. Use only 3 levels in the grid. For the mtry parameter, you need to put finalize(mtry(), lending_training %>% select(-Class)) in as an argument instead of just mtry(), where lending_training is the name of your training data. This is because the mtry() grid will otherwise have unknowns in it. This part can take a while to run.

set.seed(494)

metric <- metric_set(roc_auc, accuracy)

#choose penalty parameter values
penalty_grid_forest <- grid_regular(finalize(mtry(), lending_club_training %>% select(-Class)), min_n(), levels = 3)

penalty_grid_forest

ctrl_grid <- control_stack_grid()

#tune using 5-fold cv
lending_forest_tune <-
  lending_forest_wf %>%
  tune_grid(
    resamples = lending_cv,
    grid = penalty_grid_forest,
    control = ctrl_grid,
    metrics = metric
  )

lending_forest_tune

10. Find the best tuning parameters. What are the accuracy and area under the ROC curve for the model with those tuning parameters?

#select best tuning parameter (accuracy-wise)
best_accuracy_lending <- lending_forest_tune %>%
  select_best(metric = "accuracy")

best_accuracy_lending

best_roc_lending <- lending_forest_tune %>%
  select_best(metric = "roc_auc")

best_roc_lending

lending_forest_accuracy <- lending_forest_tune %>%
  collect_metrics() %>%
  filter(.metric == "accuracy")

lending_forest_roc <- lending_forest_tune %>%
  collect_metrics() %>%
  filter(.metric == "roc_auc")

#best mtry is 10 and best min_n is 2

#accuracy for best tuning parameters: 0.9905639

#roc_auc for best tuning parameters: 0.9949828

# finalize workflow
lending_forest_final_wf <- lending_forest_wf %>%
  finalize_workflow(best_accuracy_lending)

#fit final model with best tuning parameter
lending_forest_final_mod <- lending_forest_final_wf %>%
  fit(data = lending_club_training)

11. Use functions from the DALEX and DALEXtra libraries to create a histogram and boxplot of the residuals from the training data. How do they look? Any interesting behavior?

#create explainer ("an object that provides a uniform interface for different models.")
lending_forest_explain <- 
  explain_tidymodels(
    model = lending_forest_final_mod,
    data = lending_club_training %>% 
      select(-Class), 
    y = lending_club_training %>%
      mutate(Class_num = as.integer(Class =="good")) %>%
      pull(Class_num),
    label = "rf"
  )

## Preparation of a new explainer is initiated
##   -> model label       :  rf 
##   -> data              :  9643  rows  20  cols 
##   -> data              :  tibble converted into a data.frame 
##   -> target variable   :  9643  values 
##   -> predict function  :  yhat.workflow  will be used (  default  )
##   -> predicted values  :  No value for predict function target column. (  default  )
##   -> model_info        :  package tidymodels , ver. 0.1.2 , task classification (  default  ) 
##   -> predicted values  :  numerical, min =  0 , mean =  0.7031608 , max =  1  
##   -> residual function :  difference between y and yhat (  default  )
##   -> residuals         :  numerical, min =  -0.41 , mean =  0.02327284 , max =  0.2525  
##   A new explainer has been created! 

#create explainer ("an object that provides a uniform interface for different models.")
lending_lasso_explain <- 
  explain_tidymodels(
    model = lending_lasso_final_mod,
    data = lending_club_training %>%
      select(-Class), 
    y = lending_club_training %>%
      mutate(Class_num = as.integer(Class =="good")) %>%
      pull(Class_num),
    label = "lasso"
  )

## Preparation of a new explainer is initiated
##   -> model label       :  lasso 
##   -> data              :  9643  rows  20  cols 
##   -> data              :  tibble converted into a data.frame 
##   -> target variable   :  9643  values 
##   -> predict function  :  yhat.workflow  will be used (  default  )
##   -> predicted values  :  No value for predict function target column. (  default  )
##   -> model_info        :  package tidymodels , ver. 0.1.2 , task classification (  default  ) 
##   -> predicted values  :  numerical, min =  0.4558564 , mean =  0.9353142 , max =  0.9966348  
##   -> residual function :  difference between y and yhat (  default  )
##   -> residuals         :  numerical, min =  -0.993638 , mean =  -0.2088805 , max =  0.4951364  
##   A new explainer has been created! 

lasso_mod_perf <- model_performance(lending_lasso_explain)
rf_mod_perf <- model_performance(lending_forest_explain)

#histogram of residuals of training data
hist_plot <- 
  plot(rf_mod_perf, 
       geom = "histogram")

box_plot <-
  plot(rf_mod_perf, 
       geom = "boxplot")

hist_plot + box_plot

Although this matters more for quantitative variables want the plot of the residuals to be normally distributed. In this case, the residuals seem to have a giant spike at 0 (which is good) and are slightly right-skewed.

12. Use DALEX functions to create a variable importance plot from this model. What are the most important variables?

set.seed(10) #since we are sampling & permuting, we set a seed so we can replicate the results
rf_var_imp <- 
  model_parts(
    lending_forest_explain
    )

plot(rf_var_imp, show_boxplots = TRUE)

#Here, the most important variables in predicting Class are annual_inc (self-reported annual income), int_rate (interest rate on the loan), and revol_util (amount of credit borrower is using relative to all available revolving credit)

13. Write a function called cp_profile to make a CP profile. The function will take an explainer, a new observation, and a variable name as its arguments and create a CP profile for a quantitative predictor variable. You will need to use the predict_profile() function inside the function you create - put the variable name there so the plotting part is easier. You’ll also want to use aes_string() rather than aes() and quote the variables. Use the cp_profile() function to create one CP profile of your choosing. Be sure to choose a variable that is numeric, not integer. There seem to be issues with those that I’m looking into.

#ceteris parabus profiles, or CP profiles, show how one variable affects the outcome, holding all other variables fixed, for one observation.

#var_name must be numeric (not integer) and in quotations
cp_profile <- function(explainer, new_obs, var_name) {
  cpp <- predict_profile(explainer = explainer, 
                  new_observation = new_obs,
                  variables = var_name)
  cpp %>% rename(yhat = `_yhat_`) %>% 
   ggplot(aes_string(x = var_name,
              y = "yhat")) +
   geom_line() 
}

obs4 <- lending_club_training %>% 
  slice(4)
obs4

cp_profile(lending_forest_explain, obs4, "int_rate")

For an extra challenge, write a function that will work for either a quantitative or categorical variable.

If you need help with function writing check out the Functions chapter of R4DS by Wickham and Grolemund.

14. Use DALEX functions to create partial dependence plots (with the CP profiles in gray) for the 3-4 most important variables. If the important variables are categorical, you can instead make a CP profile for 3 observations in the dataset and discuss how you could go about constructing a partial dependence plot for a categorical variable (you don’t have to code it, but you can if you want an extra challenge). If it ever gives you an error that says, “Error: Can’t convert from VARIABLE to VARIABLE due to loss of precision”, then remove that variable from the list. I seem to have figured out why it’s doing that, but I don’t know how to fix it yet.

set.seed(494) # since we take a sample of 100 obs
# This takes a while to run. 
# If we only want to examine a few variables, add variables argument to model_profile.

rf_pdp <- model_profile(explainer = lending_forest_explain, variables = c("int_rate", "annual_inc", "revol_util"))

plot(rf_pdp, 
     variables = c("int_rate", "annual_inc", "revol_util"),
     geom = "profiles")

15. Fit one more model type of your choosing that will feed into the stacking model.

K-nearest neighbors

# create a model definition
lending_knn_mod <-
  nearest_neighbor(
    neighbors = tune("k")
  ) %>%
  set_engine("kknn") %>% 
  set_mode("classification")

# create the workflow
knn_wf <- 
  workflow() %>% 
  add_model(lending_knn_mod) %>%
  add_recipe(lending_recipe)

# tune it using 4 tuning parameters
lending_knn_tune <- 
  knn_wf %>% 
  tune_grid(
    lending_cv,
    metrics = metric,
    grid = 4,
    control = ctrl_grid
  )

16. Create a model stack with the candidate models from the previous parts of the exercise and use the blend_predictions() function to find the coefficients of the stacked model. Create a plot examining the performance metrics for the different penalty parameters to assure you have captured the best one. If not, adjust the penalty. (HINT: use the autoplot() function). Which models are contributing most?

lending_stack <-
  stacks() %>%
  add_candidates(lending_forest_tune) %>%
  add_candidates(lending_lasso_tune) %>%
  add_candidates(lending_knn_tune)

## Warning: Predictions from the candidates c(".pred_bad_lending_lasso_tune_1_02",
## ".pred_bad_lending_lasso_tune_1_03", ".pred_bad_lending_lasso_tune_1_04",
## ".pred_bad_lending_lasso_tune_1_05", ".pred_bad_lending_lasso_tune_1_06",
## ".pred_good_lending_lasso_tune_1_02", ".pred_good_lending_lasso_tune_1_03",
## ".pred_good_lending_lasso_tune_1_04", ".pred_good_lending_lasso_tune_1_05",
## ".pred_good_lending_lasso_tune_1_06") were identical to those from existing
## candidates and were removed from the data stack.

as_tibble(lending_stack)

lending_blend <- 
  lending_stack %>% 
  blend_predictions()

lending_blend

## ── A stacked ensemble model ─────────────────────────────────────

## 
## Out of 18 possible candidate members, the ensemble retained 1.
## Lasso penalty: 0.1.

## 
## The 1 highest weighted member classes are:

## # A tibble: 1 x 3
##   member                             type        weight
##   <chr>                              <chr>        <dbl>
## 1 .pred_good_lending_forest_tune_1_2 rand_forest   4.90

## 
## Members have not yet been fitted with `fit_members()`.

autoplot(lending_blend)

The random forest model is contributing the most (in fact, it’s the only one contributing in this case?).

17. Fit the final stacked model using fit_members(). Apply the model to the test data and report the accuracy and area under the curve. Create a graph of the ROC and construct a confusion matrix. Comment on what you see. Save this final model using the saveRDS() function - see the Use the model section of the tidymodels intro. We are going to use the model in the next part. You’ll want to save it in the folder where you create your shiny app.

lending_final_stack <- lending_blend %>% 
  fit_members()

lending_final_stack

## ── A stacked ensemble model ─────────────────────────────────────

## 
## Out of 18 possible candidate members, the ensemble retained 1.
## Lasso penalty: 0.1.

## 
## The 1 highest weighted member classes are:

## # A tibble: 1 x 3
##   member                             type        weight
##   <chr>                              <chr>        <dbl>
## 1 .pred_good_lending_forest_tune_1_2 rand_forest   4.90

final_stack_table <- lending_final_stack %>% 
  predict(new_data = lending_club_testing) %>% 
  bind_cols(lending_club_testing) %>%
  mutate(correct_prediction = ifelse(.pred_class == Class, TRUE, FALSE))

#accuracy
final_stack_accuracy <- accuracy(final_stack_table, Class, .pred_class)
final_stack_accuracy

#accuracy is 0.9965775

#area under the curve
lending_final_stack$metrics %>% 
  filter(.metric == "roc_auc")

#roc_auc is 0.9949827

#ROC
autoplot(lending_final_stack)

#confusion matrix
conf_mat(data = final_stack_table, truth = Class, estimate = .pred_class)

##           Truth
## Prediction  bad good
##       bad   868    0
##       good   11 2335

**I see that this blended model (which is essentially the random forest model with the best tuning parameters) has a super high accuracy and roc_auc.

Shiny app

If you are new to Shiny apps or it’s been awhile since you’ve made one, visit the Shiny links on our course Resource page. I would recommend starting with my resource because it will be the most basic. You won’t be doing anything super fancy in this app.

Everyone should watch the Theming Shiny talk by Carson Sievert so you can make your app look amazing.

Tasks:

You are going to create an app that allows a user to explore how the predicted probability of a loan being paid back (or maybe just the predicted class - either “good” or “bad”) changes depending on the values of the predictor variables.

Specifically, you will do the following:

• Set up a separate project and GitHub repo for this app. Make sure the saved model from the previous problem is also in that folder. The app needs to be created in a file called exactly app.R that is also in the project folder.
  
• At the top of the file, load any libraries you use in the app.
  
• Use the readRDS() function to load the model.
  
• You may want to load some of the data to use
• Create a user interface (using the various *Input() functions) where someone could enter values for each variable that feeds into the model. You will want to think hard about which types of *Input() functions to use. Think about how you can best prevent mistakes (eg. entering free text could lead to many mistakes).
• Another part of the user interface will allow them to choose a variable (you can limit this to only the quantitative variables) where they can explore the effects of changing that variable, holding all others constant.
  
• After the user has entered all the required values, the output will be a CP profile with the the predicted value for the data that was entered, indicated by a point. I don’t think the functions from DALEX and DALEXtra will work with a stacked model, so you’ll likely have to (get to) do some of your own coding.
• Use the bslib to theme your shiny app!
  
• Publish your app to shinyapps.io. There are instructions for doing that on the tutorial I linked to above.
  
• Write a paragraph or two describing your app on your website! Link to the app and your GitHub repository in your post. Include a link to your post here.

Coded Bias

Watch the Code Bias film and write a short reflection. If you want some prompts, reflect on: What part of the film impacted you the most? Was there a part that surprised you and why? What emotions did you experience while watching?

I think that the quote and common theme that “the past dwells within our algorithms” is crucial to be aware of. How the data was collected and who is represented (and who isn’t) reflects where our society was at the time of collection. Therefore, how are we going to make progress in being less discriminatory and more inclusive in the future if the algorithms are basing their assignments on the past? I wonder if there is some way to simulate future data or just do something to make past data more representative of current and future needs.

Coded Bias also led me to think a lot about how we compare our society with one such as China. We feel relieved that we don’t live in a society with constant facial recognition and social credit scores, but our society is tracking us and being exclusionary based on the (often inaccurate) data they gather about us. We have pervasive algorithmic bias that is geared toward capitalistic gain, keeping the rich rich, and keeping minority populations down (ex. the facial recognition in the apartment building from the documentary). It was creepy (and true) that the documentary said that the main difference between the surveillance of the US and China is that China is being transparent about it, whereas we are letting it fly under the radar.

REMEMBER TO ADD YOUR GITHUB LINK AT THE TOP OF THE PAGE AND UNCOMMENT THE knitr OPTIONS.